home *** CD-ROM | disk | FTP | other *** search
/ PC World 2007 March / PCWorld_2007-03_cd.bin / domacnost a kancelar / scribus / scribus-1.3.3.7-win32-install.exe / tcl / tk8.4 / demos / widget < prev   
Text File  |  2003-09-24  |  13KB  |  395 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. # widget --
  6. # This script demonstrates the various widgets provided by Tk,
  7. # along with many of the features of the Tk toolkit.  This file
  8. # only contains code to generate the main window for the
  9. # application, which invokes individual demonstrations.  The
  10. # code for the actual demonstrations is contained in separate
  11. # ".tcl" files is this directory, which are sourced by this script
  12. # as needed.
  13. #
  14. # RCS: @(#) $Id: widget,v 1.9.2.1 2003/09/25 05:37:48 das Exp $
  15.  
  16. eval destroy [winfo child .]
  17. wm title . "Widget Demonstration"
  18. if {[tk windowingsystem] eq "x11"} {
  19.     # This won't work everywhere, but there's no other way in core Tk
  20.     # at the moment to display a coloured icon.
  21.     image create photo TclPowered \
  22.         -file [file join $tk_library images logo64.gif]
  23.     wm iconwindow . [toplevel ._iconWindow]
  24.     pack [label ._iconWindow.i -image TclPowered]
  25.     wm iconname . "tkWidgetDemo"
  26. }
  27.  
  28. array set widgetFont {
  29.     main   {Helvetica 12}
  30.     bold   {Helvetica 12 bold}
  31.     title  {Helvetica 18 bold}
  32.     status {Helvetica 10}
  33.     vars   {Helvetica 14}
  34. }
  35.  
  36. set widgetDemo 1
  37. set font $widgetFont(main)
  38.  
  39. #----------------------------------------------------------------
  40. # The code below create the main window, consisting of a menu bar
  41. # and a text widget that explains how to use the program, plus lists
  42. # all of the demos as hypertext items.
  43. #----------------------------------------------------------------
  44.  
  45. menu .menuBar -tearoff 0
  46. .menuBar add cascade -menu .menuBar.file -label "File" -underline 0
  47. menu .menuBar.file -tearoff 0
  48.  
  49. # On the Mac use the specia .apple menu for the about item
  50. if {[tk windowingsystem] eq "classic" || [tk windowingsystem] eq "aqua"} {
  51.     .menuBar add cascade -menu .menuBar.apple
  52.     menu .menuBar.apple -tearoff 0
  53.     .menuBar.apple add command -label "About..." -command "aboutBox"
  54. } else {
  55.     .menuBar.file add command -label "About..." -command "aboutBox" \
  56.     -underline 0 -accelerator "<F1>"
  57.     .menuBar.file add sep
  58. }
  59.  
  60. .menuBar.file add command -label "Quit" -command "exit" -underline 0 \
  61.     -accelerator "Meta-Q"
  62. . configure -menu .menuBar
  63. bind . <F1> aboutBox
  64.  
  65. frame .statusBar
  66. label .statusBar.lab -text "   " -relief sunken -bd 1 \
  67.     -font $widgetFont(status) -anchor w
  68. label .statusBar.foo -width 8 -relief sunken -bd 1 \
  69.     -font $widgetFont(status) -anchor w
  70. pack .statusBar.lab -side left -padx 2 -expand yes -fill both
  71. pack .statusBar.foo -side left -padx 2
  72. pack .statusBar -side bottom -fill x -pady 2
  73.  
  74. frame .textFrame
  75. scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
  76.     -takefocus 1
  77. pack .s -in .textFrame -side right -fill y
  78. text .t -yscrollcommand {.s set}  -wrap word  -width 70  -height 30 \
  79.     -font $widgetFont(main)  -setgrid 1  -highlightthickness 0 \
  80.     -padx 4  -pady 2  -takefocus 0
  81. pack .t -in .textFrame -expand y -fill both -padx 1
  82. pack  .textFrame -expand yes -fill both
  83.  
  84. # Create a bunch of tags to use in the text widget, such as those for
  85. # section titles and demo descriptions.  Also define the bindings for
  86. # tags.
  87.  
  88. .t tag configure title -font $widgetFont(title)
  89. .t tag configure bold  -font $widgetFont(bold)
  90.  
  91. # We put some "space" characters to the left and right of each demo description
  92. # so that the descriptions are highlighted only when the mouse cursor
  93. # is right over them (but not when the cursor is to their left or right)
  94. #
  95. .t tag configure demospace -lmargin1 1c -lmargin2 1c
  96.  
  97.  
  98. if {[winfo depth .] == 1} {
  99.     .t tag configure demo -lmargin1 1c -lmargin2 1c \
  100.     -underline 1
  101.     .t tag configure visited -lmargin1 1c -lmargin2 1c \
  102.     -underline 1
  103.     .t tag configure hot -background black -foreground white
  104. } else {
  105.     .t tag configure demo -lmargin1 1c -lmargin2 1c \
  106.     -foreground blue -underline 1
  107.     .t tag configure visited -lmargin1 1c -lmargin2 1c \
  108.     -foreground #303080 -underline 1
  109.     .t tag configure hot -foreground red -underline 1
  110. }
  111. .t tag bind demo <ButtonRelease-1> {
  112.     invoke [.t index {@%x,%y}]
  113. }
  114. set lastLine ""
  115. .t tag bind demo <Enter> {
  116.     set lastLine [.t index {@%x,%y linestart}]
  117.     .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  118.     .t config -cursor hand2
  119.     showStatus [.t index {@%x,%y}]
  120. }
  121. .t tag bind demo <Leave> {
  122.     .t tag remove hot 1.0 end
  123.     .t config -cursor xterm
  124.     .statusBar.lab config -text ""
  125. }
  126. .t tag bind demo <Motion> {
  127.     set newLine [.t index {@%x,%y linestart}]
  128.     if {[string compare $newLine $lastLine] != 0} {
  129.     .t tag remove hot 1.0 end
  130.     set lastLine $newLine
  131.  
  132.     set tags [.t tag names {@%x,%y}]
  133.     set i [lsearch -glob $tags demo-*]
  134.     if {$i >= 0} {
  135.         .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
  136.     }
  137.     }
  138.     showStatus [.t index {@%x,%y}]
  139. }
  140.  
  141. # Create the text for the text widget.
  142.  
  143. proc addDemoSection {title demos} {
  144.     .t insert end "\n" {} $title title " \n " demospace
  145.     set num 0
  146.     foreach {name description} $demos {
  147.     .t insert end "[incr num]. $description." [list demo demo-$name]
  148.     .t insert end " \n " demospace
  149.     }
  150. }
  151.  
  152. .t insert end "Tk Widget Demonstrations\n" title
  153. .t insert end "\nThis application provides a front end for several short\
  154.     scripts that demonstrate what you can do with Tk widgets.  Each of\
  155.     the numbered lines below describes a demonstration;  you can click\
  156.     on it to invoke the demonstration.  Once the demonstration window\
  157.     appears, you can click the " {} "See Code" bold " button to see the\
  158.     Tcl/Tk code that created the demonstration.  If you wish, you can\
  159.     edit the code and click the " {} "Rerun Demo" bold " button in the\
  160.     code window to reinvoke the demonstration with the modified code.\n"
  161.  
  162. addDemoSection "Labels, buttons, checkbuttons, and radiobuttons" {
  163.     label    "Labels (text and bitmaps)"
  164.     unicodeout    "Labels and UNICODE text"
  165.     button    "Buttons"
  166.     check    "Check-buttons (select any of a group)"
  167.     radio    "Radio-buttons (select one of a group)"
  168.     puzzle    "A 15-puzzle game made out of buttons"
  169.     icon    "Iconic buttons that use bitmaps"
  170.     image1    "Two labels displaying images"
  171.     image2    "A simple user interface for viewing images"
  172.     labelframe    "Labelled frames"
  173. }
  174. addDemoSection "Listboxes" {
  175.     states    "The 50 states"
  176.     colors    "Colors: change the color scheme for the application"
  177.     sayings    "A collection of famous and infamous sayings"
  178. }
  179. addDemoSection "Entries and Spin-boxes" {
  180.     entry1    "Entries without scrollbars"
  181.     entry2    "Entries with scrollbars"
  182.     entry3    "Validated entries and password fields"
  183.     spin    "Spin-boxes"
  184.     form    "Simple Rolodex-like form"
  185. }
  186. addDemoSection "Text" {
  187.     text    "Basic editable text"
  188.     style    "Text display styles"
  189.     bind    "Hypertext (tag bindings)"
  190.     twind    "A text widget with embedded windows"
  191.     search    "A search tool built with a text widget"
  192. }
  193. addDemoSection "Canvases" {
  194.     items    "The canvas item types"
  195.     plot    "A simple 2-D plot"
  196.     ctext    "Text items in canvases"
  197.     arrow    "An editor for arrowheads on canvas lines"
  198.     ruler    "A ruler with adjustable tab stops"
  199.     floor    "A building floor plan"
  200.     cscroll    "A simple scrollable canvas"
  201. }
  202. addDemoSection "Scales" {
  203.     hscale    "Horizontal scale"
  204.     vscale    "Vertical scale"
  205. }
  206. addDemoSection "Paned Windows" {
  207.     paned1    "Horizontal paned window"
  208.     paned2    "Vertical paned window"
  209. }
  210. addDemoSection "Menus" {
  211.     menu    "Menus and cascades (sub-menus)"
  212.     menubu    "Menu-buttons"
  213. }
  214. addDemoSection "Common Dialogs" {
  215.     msgbox    "Message boxes"
  216.     filebox    "File selection dialog"
  217.     clrpick    "Color picker"
  218. }
  219. addDemoSection "Miscellaneous" {
  220.     bitmap    "The built-in bitmaps"
  221.     dialog1    "A dialog box with a local grab"
  222.     dialog2    "A dialog box with a global grab"
  223. }
  224.  
  225. .t configure -state disabled
  226. focus .s
  227.  
  228. # positionWindow --
  229. # This procedure is invoked by most of the demos to position a
  230. # new demo window.
  231. #
  232. # Arguments:
  233. # w -        The name of the window to position.
  234.  
  235. proc positionWindow w {
  236.     wm geometry $w +300+300
  237. }
  238.  
  239. # showVars --
  240. # Displays the values of one or more variables in a window, and
  241. # updates the display whenever any of the variables changes.
  242. #
  243. # Arguments:
  244. # w -        Name of new window to create for display.
  245. # args -    Any number of names of variables.
  246.  
  247. proc showVars {w args} {
  248.     global widgetFont
  249.     catch {destroy $w}
  250.     toplevel $w
  251.     wm title $w "Variable values"
  252.     label $w.title -text "Variable values:" -width 20 -anchor center \
  253.         -font $widgetFont(vars)
  254.     pack $w.title -side top -fill x
  255.     set len 1
  256.     foreach i $args {
  257.     if {[string length $i] > $len} {
  258.         set len [string length $i]
  259.     }
  260.     }
  261.     foreach i $args {
  262.     frame $w.$i
  263.     label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
  264.     label $w.$i.value -textvar $i -anchor w
  265.     pack $w.$i.name -side left
  266.     pack $w.$i.value -side left -expand 1 -fill x
  267.     pack $w.$i -side top -anchor w -fill x
  268.     }
  269.     button $w.ok -text OK -command "destroy $w" -default active
  270.     bind $w <Return> "tkButtonInvoke $w.ok"
  271.     pack $w.ok -side bottom -pady 2
  272. }
  273.  
  274. # invoke --
  275. # This procedure is called when the user clicks on a demo description.
  276. # It is responsible for invoking the demonstration.
  277. #
  278. # Arguments:
  279. # index -    The index of the character that the user clicked on.
  280.  
  281. proc invoke index {
  282.     global tk_library
  283.     set tags [.t tag names $index]
  284.     set i [lsearch -glob $tags demo-*]
  285.     if {$i < 0} {
  286.     return
  287.     }
  288.     set cursor [.t cget -cursor]
  289.     .t configure -cursor watch
  290.     update
  291.     set demo [string range [lindex $tags $i] 5 end]
  292.     uplevel [list source [file join $tk_library demos $demo.tcl]]
  293.     update
  294.     .t configure -cursor $cursor
  295.  
  296.     .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
  297. }
  298.  
  299. # showStatus --
  300. #
  301. #    Show the name of the demo program in the status bar. This procedure
  302. #    is called when the user moves the cursor over a demo description.
  303. #
  304. proc showStatus index {
  305.     global tk_library
  306.     set tags [.t tag names $index]
  307.     set i [lsearch -glob $tags demo-*]
  308.     set cursor [.t cget -cursor]
  309.     if {$i < 0} {
  310.     .statusBar.lab config -text " "
  311.     set newcursor xterm
  312.     } else {
  313.     set demo [string range [lindex $tags $i] 5 end]
  314.     .statusBar.lab config -text "Run the \"$demo\" sample program"
  315.     set newcursor hand2
  316.     }
  317.     if [string compare $cursor $newcursor] {
  318.     .t config -cursor $newcursor
  319.     }
  320. }
  321.  
  322.  
  323. # showCode --
  324. # This procedure creates a toplevel window that displays the code for
  325. # a demonstration and allows it to be edited and reinvoked.
  326. #
  327. # Arguments:
  328. # w -        The name of the demonstration's window, which can be
  329. #        used to derive the name of the file containing its code.
  330.  
  331. proc showCode w {
  332.     global tk_library
  333.     set file [string range $w 1 end].tcl
  334.     if ![winfo exists .code] {
  335.     toplevel .code
  336.     frame .code.buttons
  337.     pack .code.buttons -side bottom -fill x
  338.     button .code.buttons.dismiss -text Dismiss \
  339.             -default active -command "destroy .code"
  340.     button .code.buttons.rerun -text "Rerun Demo" -command {
  341.         eval [.code.text get 1.0 end]
  342.     }
  343.     pack .code.buttons.dismiss .code.buttons.rerun -side left \
  344.         -expand 1 -pady 2
  345.     frame .code.frame
  346.     pack  .code.frame -expand yes -fill both -padx 1 -pady 1
  347.     text .code.text -height 40 -wrap word\
  348.         -xscrollcommand ".code.xscroll set" \
  349.         -yscrollcommand ".code.yscroll set" \
  350.         -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
  351.     scrollbar .code.xscroll -command ".code.text xview" \
  352.         -highlightthickness 0 -orient horizontal
  353.     scrollbar .code.yscroll -command ".code.text yview" \
  354.         -highlightthickness 0 -orient vertical
  355.  
  356.     grid .code.text -in .code.frame -padx 1 -pady 1 \
  357.         -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
  358.     grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
  359.         -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
  360. #    grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
  361. #        -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
  362.     grid rowconfig    .code.frame 0 -weight 1 -minsize 0
  363.     grid columnconfig .code.frame 0 -weight 1 -minsize 0
  364.     } else {
  365.     wm deiconify .code
  366.     raise .code
  367.     }
  368.     wm title .code "Demo code: [file join $tk_library demos $file]"
  369.     wm iconname .code $file
  370.     set id [open [file join $tk_library demos $file]]
  371.     .code.text delete 1.0 end
  372.     .code.text insert 1.0 [read $id]
  373.     .code.text mark set insert 1.0
  374.     close $id
  375. }
  376.  
  377. # aboutBox --
  378. #
  379. #    Pops up a message box with an "about" message
  380. #
  381. proc aboutBox {} {
  382.     tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
  383. "Tk widget demonstration
  384.  
  385. Copyright (c) 1996-1997 Sun Microsystems, Inc.
  386.  
  387. Copyright (c) 1997-2000 Ajuba Solutions, Inc.
  388.  
  389. Copyright (c) 2001-2002 Donal K. Fellows"
  390. }
  391.  
  392. # Local Variables:
  393. # mode: tcl
  394. # End:
  395.